home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE09 / FILES / NAMES3U2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-09  |  4.1 KB  |  155 lines

  1. unit Names3u2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.   TDataRec = packed record
  10.     { The form's edit box has its MaxLength property set to 30 }
  11.     Name: String[30];
  12.     { Only interested in the date portion of this date/time value }
  13.     DOB: TDateTime;
  14.   end;
  15.  
  16.   TDataFile = class
  17.   private
  18.     FDataFile: Integer;
  19.   protected
  20.     function GetCount: Longint;
  21.     function GetCurrent: Longint;
  22.     function GetRecord(Index: Longint): TDataRec;
  23.     procedure SetCurrent(RecNo: Longint);
  24.     procedure SetRecord(Index: Longint; const DataRec: TDataRec);
  25.   public
  26.     constructor Create;
  27.     destructor Destroy; override;
  28.     property Count: Longint read GetCount;
  29.     property Current: Longint
  30.       read GetCurrent write SetCurrent;
  31.     property Records[Index: Longint]: TDataRec
  32.       read GetRecord write SetRecord; default;
  33.   end;
  34.  
  35. implementation
  36.  
  37. uses
  38.   WinProcs, Forms, NetLock, Consts, Classes;
  39.  
  40. const
  41.   FileName = 'DataFile.Dat';
  42.  
  43. {$ifndef Win32}
  44. function GetFileSize(Handle: Integer): Longint;
  45. var
  46.   FileSize: Longint;
  47. begin
  48.   Result := FileSeek(Handle, 0, soFromCurrent);
  49.   if Result > -1 then
  50.   begin
  51.     FileSize := FileSeek(Handle, 0, soFromEnd);
  52.     FileSeek(Handle, Result, soFromBeginning);
  53.     Result := FileSize;
  54.   end;
  55. end;
  56. {$endif}
  57.  
  58. {$ifdef Ver80}
  59. function ExtractFileDir(const FileName: String): String;
  60. var
  61.   I: Integer;
  62. begin
  63.   Result := ExtractFilePath(FileName);
  64.   I := Length(Result);
  65.   if (I > 1) and (FileName[I] = '\') and (FileName[I - 1] <> ':') then
  66.     { This is compiled in Delphi 1 only, so this is fine }
  67.     Dec(Result[0]);
  68. end;
  69. {$endif}
  70.  
  71. constructor TDataFile.Create;
  72. begin
  73.   { Make current directory where EXE file is, just in case }
  74.   ChDir(ExtractFileDir(Application.ExeName));
  75.   { Make file if it ain't there }
  76.   if not FileExists(FileName) then
  77.     FDataFile := FileCreate(FileName);
  78.   if FDataFile < 0 then
  79.     raise EFCreateError.Create(FmtLoadStr(SFCreateError, [FileName]));
  80.   { Close handle returned by FileCreate so we can open it in shared mode }
  81.   FileClose(FDataFile);
  82.   FDataFile := FileOpen(FileName, fmOpenReadWrite or fmShareDenyNone);
  83.   if FDataFile < 0 then
  84.     raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));
  85. end;
  86.  
  87. destructor TDataFile.Destroy;
  88. begin
  89.   FileClose(FDataFile);
  90.   inherited Destroy;
  91. end;
  92.  
  93. function TDataFile.GetCount: Longint;
  94. begin
  95. {$ifndef Win32}
  96.   Result := GetFileSize(FDataFile) div SizeOf(TDataRec);
  97. {$else}
  98.   Result := GetFileSize(FDataFile, nil) div SizeOf(TDataRec);
  99. {$endif}
  100. end;
  101.  
  102. function TDataFile.GetCurrent: Longint;
  103. begin
  104.   Result := FileSeek(FDataFile, 0, soFromCurrent);
  105.   if Result > -1 then
  106.     Result := Result div SizeOf(TDataRec);
  107. end;
  108.  
  109. function TDataFile.GetRecord(Index: Longint): TDataRec;
  110. begin
  111.   Current := Index;
  112.   if FileRead(FDataFile, Result, SizeOf(TDataRec)) < SizeOf(TDataRec) then
  113.     raise EListError.CreateRes(SListIndexError);
  114.   { Go back to the beginning of the read record }
  115.   Current := Index;
  116. end;
  117.  
  118. procedure TDataFile.SetCurrent(RecNo: Longint);
  119. begin
  120.   { Anything past EOF is considered EOF }
  121.   if RecNo > Count then
  122.     RecNo := Count;
  123.   FileSeek(FDataFile, RecNo * SizeOf(TDataRec), soFromBeginning);
  124. end;
  125.  
  126. procedure TDataFile.SetRecord(Index: Longint; const DataRec: TDataRec);
  127. var
  128.   X: EInOutError;
  129. begin
  130.   Current := Index;
  131.   if not LockFileArea(FDataFile, Current * SizeOf(TDataRec),
  132.     SizeOf(TDataRec), False) then
  133.   begin
  134.     X := EInOutError.Create('Cannot lock file');
  135.     { Set up a file access denied type exception }
  136.     X.ErrorCode := 5;
  137.     raise X;
  138.   end;
  139.   try
  140.     { DataRec is passed as a const (pass by reference, but }
  141.     { not allowed to be treated/passed as a var parameter). }
  142.     { We can get around this by dereferencing its }
  143.     { address with an appropriate typecast }
  144.     if FileWrite(FDataFile, DataRec, SizeOf(TDataRec)) < SizeOf(TDataRec) then
  145.       raise EInOutError.Create('Cannot write to file');
  146.     { Go back to the beginning of the written record }
  147.     Current := Index;
  148.   finally
  149.     LockFileArea(FDataFile, Current * SizeOf(TDataRec),
  150.       SizeOf(TDataRec), True);
  151.   end;
  152. end;
  153.  
  154. end.
  155.